Shareware Grab Bag/Shareware Grab Bag.iso/003/chrchpr2.arc/CTAPELIB.CMD

Text File | 1979-12-31 | 9.5 KB | 358 lines

* Program CTAPELIB - Manages tape label records
Clear
Set intensity off
Set talk off
Set deleted on
Store 'January  February March    April    May      June     ' to MONTHS
Store MONTHS+'July     August   SeptemberOctober  November December ' to MONTHS
If $(DATE(),7,2) = '00'
  Set date to 01,01,00
ENDIF
  Store ' ' to curmonthx
  Store ' ' to curyear
  Store ' ' to curmonth
  * Set today's date from current system-date
  Store $(date(),1,2) to curmo
  Store $(date(),7,2) to curmonthx
  Store val(curmo) to nmonth
  Store curmo+curmonthx to indate
  Store VAL(curmonthx) to CURYEAR
  If $(date(),4,1) = '0'
    Store $(DATE(),5,1) to CURMONTHX
  else
    Store $(DATE(),4,2) to CURMONTHX
  endif
  Store trim($(months,NMONTH*9-8,9)) to curmonth
  Store curmonth+' '+curmonthx to curmonthx
  Store ', 19'+$(DATE(),7,2) to CURYEAR
  Store curmonthx+curyear to curdate
Select primary
Use UDIRFILE
release curmo,months,curyear,curmonthx
GOTO 2
Store !($(spact,21,1)) to D
GOTO 5
Store val($(spact,28,2)) to labellpp
SKIP
Store val($(spact,28,2)) to labelspa
SKIP
Store val($(spact,28,2)) to labl1col
Store d+':TLABELS.NDX' to MFILENDX
Set talk off
Store T to continue
Do while continue
  USE
  Select primary
  Use
  Store D+':TLABELS' to MFILE
  ERASE
  @ 1,1 say 'DATA DISK = '+D
  @ 1,60 say curdate
  @ 2,20 say 'TAPE LABELS Program'
  @ 5,9 say  '1.  Enter new labels'
  @ 6,9 say  '2.  Print labels    '
  @ 7,9 say  '3.  Edit an existing label'
  @ 8,9 say  '4.  Print all existing labels by date, on the printer'
  @ 9,9 say  '5.  Create a new, empty TLABELS file'
  @ 10,9 say '6.  Names Directory Editing'
  ?
  Accept '         Enter selection ' to ESEL
  ?
  If !(ESEL)='DISK='
    If len(ESEL)>5
      Store !($(ESEL,6,1)) to D
      ? 'Now changing the data disk to drive',D
      Store D+':TLABELS' to MFILE
    endif
    Store D to ESEL
  endif
  Do while @(ESEL,'123456QqD')=0
   Accept 'Invalid entry. Please enter again ' to ESEL
  enddo
  If ESEL<>'6'.and.!(ESEL)<>'Q'
    If file(MFILE)
      Use &MFILE index &MFILE
    else
      ? 'File',MFILE,'not found on the data disk. Perform SET UP to create it.'
      ?
    endif
  endif
  Do case
    Case ESEL = '1'
Store 'Y' to level2
Do while !(LEVEL2)<>'N' .and. !(LEVEL2)<>'Q'
ERASE
Store '                                        ' to xtitle,xtitle2,xtext
Store '                      ' to xspeaker
Store '          ' to XDATE
@ 2,20 say  'Tape Labels - New entry'
@ 5,3 say 'TITLE    ' get xtitle
@ 6,12 get XTITLE2
@ 7,3 say  'TEXT     ' get xtext
@ 8,3 say  'SPEAKER  ' get XSPEAKER
@ 9,3 say  'DATE     ' get xdate
@ 9,43 say 'SERIES  ' get series
@ 11,20 say 'Press ctrl-W when finished.'
READ
If xtitle<>'                    '
  Append blank
  Replace title with xtitle
  Replace title2 with xtitle2
  Replace text with xtext
  Replace speaker with xspeaker
  Replace date with xdate
  Replace DATESORT with $(DATE,7,2)+$(date,1,2)+$(DATE,4,2)+$(date,10,1)
else
  ? 'TITLE is blank. No entry is made.'
endif
Accept 'Another? ' to LEVEL2
enddo
Use &MFILE index &MFILE
    Case ESEL = '2'
Store 'Y' to LEVEL2
Do while !(LEVEL2)<>'Q' .and. !(LEVEL2)<>' ' .and. !(level2)<>'N'
Store T to invalid1
Do while invalid1
 ? 'Enter the date designator of the label you desire.'
 ? 'Date designator format: MM/DD/YY,T (month/day/year,time)'
 Accept '                       ' to  indate
 If !(indate)='Q' .or. ' '=indate
  Store 'Q' to level2
  Store  F to invalid1
 else
  If $(indate,2,1) = '-' .or. $(indate,2,1) = '/'
   Store ' '+indate to indate
  endif
  Store len(trim(indate)) to lenind
  If lenind<10
   Accept 'Date designator is too short. Enter again' to indate
  else
  Store $(indate,7,2)+$(indate,1,2)+$(indate,4,2)+$(indate,10,1) to indatex
  Find &indatex
  If # = 0
    ? 'No label record found with this date:',indate
  else
    Store F to invalid1
  endif
  endif
ENDDO
If !(level2)<>'Q'
 Accept 'Enter the number of label copies wanted' to tln
 Store val(tln) to tlnumb
 Store 0 to lnumb
 Store labellpp-2 to lbpage
 Do while tlnumb > 0
  Set format to print
  Store lnumb to linenum
  Store tlnumb-1 to tlnumb
  Store len(trim(title)) to titlelen
  Store (32-titlelen)/2 to inset
  @ linenum,labl1col+inset say title
  Store len(trim(title2)) to titlelen
  If titlelen <> 1
    Store (32-titlelen)/2 to inset
    @ linenum+1,labl1col+inset say title2
    Store linenum+1 to linenum
  endif
  @ linenum+1,labl1col say text
  @ linenum+2,labl1col say speaker
  @ linenum+2,labl1col+24 say date
  Store lnumb+labelspa to lnumb
  If lnumb>lbpage
    EJECT
    Store 0 to lnumb
  endif
 enddo
 If lnumb<=lbpage
 EJECT
 endif
 Set format to screen
 ?
  ACCEPT 'Another? ' to level2
 endif
endif
ENDDO
    CASE ESEL = '3'
Store 'Y' to invalid9
Do while !(invalid9)<>'N'.and.invalid9<>' '.and.!(invalid9)<>'Q'
Store T to invalid1
? 'Enter date to the desired tape'
     ? 'Date format is: MM/DD/YY,T'
Accept '               ' to inlabl
Do while invalid1
 If !(inlabl) = 'Q'
    Store 'Q' to invalid9
    Store F to invalid1
 else
  If $(inlabl,2,1) = '-' .or. $(inlabl,2,1) = '/'
    Store ' '+inlabl to inlabl
  endif
  Store len(inlabl) to lenlabl
  If lenlabl<10
    Accept 'Invalid date designator [MM/DD/YY,T]. Please re-enter ' to inlabl
  else
    Store $(inlabl,7,2)+$(inlabl,1,2)+$(inlabl,4,2)+$(inlabl,10,1) to inlablx
    Find &inlablx
    If # = 0
      Accept 'Record not found. Enter again: ' to inlabl
    else
      Store F to invalid1
    endif
  endif
 endif
enddo
If !(invalid9)<>'Q'
Store F to GOODREC
Do while .not. GOODREC
  ERASE
  @ 2,20 say 'Tape Labels - Modifying an old entry'
  @ 5,8  say 'TITLE    ' get title
  @ 6,17 get title2
  @ 7,8  say 'TEXT     ' get text
  @ 8,8 say  'SPEAKER  ' get speaker
  @ 9,8 say  'DATE     ' get date
  @ 9,40 say 'SERIES '   get series
  @ 11,20 say 'Press ctrl-W when finished'
  READ
  Store T to goodrec
  @ 12,0 say '                                                                '
  If len(trim(date))>8
    If len(trim(date))=9 .and. ($(date,2,1)='/'.or.$(date,2,1)='-')
      Replace DATE with  ' '+date
    endif
  else
    ? 'The date field must have at least 9 characters. Please re-enter.'
    Store F to goodrec
  endif
  Replace datesort with $(date,7,2)+$(date,1,2)+$(date,4,2)+$(date,10,1)
enddo
endif
Accept 'Another? ' to invalid9
enddo
USE &MFILE index &MFILE
    Case ESEL = '4'
?
Accept 'Enter a starting label date, or press <retn> for all' to inlabl
If inlabl = ' '
  GOTO top
else
  Store T to invalid2
  Do while invalid2
    If $(inlabl,2,1) = '-' .or. $(inlabl,2,1) = '/'
      Store ' '+inlabl to inlabl
    endif
    If len(inlabl) < 10
      Accept 'Invalid label designator. Please re-enter: ' to inlabl
    else
     Store $(inlabl,7,2)+$(inlabl,1,2)+$(inlabl,4,2)+$(inlabl,10,1) to inlablx
     Find &inlablx
     If # = 0
      Accept 'Label designator not found. Please re-enter: ' to inlabl
     else
      Store F to invalid2
     endif
    endif
  enddo
endif
Store 1 to pgnumb
Store 99 to linenumb
Set format to print
Do while .not. EOF
  If linenumb > labellpp
    If linenumb<>99
    EJECT
    endif
    Store STR(PGNUMB,4) to pgnumbr
    @ 2,2 say 'Tape Labels - '+curdate+'   Page'+pgnumbr
    Store 5 to linenumb
  endif
  If title2='                              '
    @ linenumb+1,4 say title
  else
    @ linenumb,4 say title
    @ linenumb+1,4 say title2
  endif
  @ linenumb+2,4 say text
  @ linenumb+3,4 say speaker
  @ linenumb+4,4 say date
  @ linenumb+4,30 say series
  Store linenumb+6 to linenumb
  SKIP
ENDDO
EJECT
Set format to screen
Accept 'Report is complete. Press <RETURN> ' to XX
    Case ESEL='5'
Accept ;
'This process clears any existing TLABELS file and makes a new one. OK?' to XX
     If !(XX)='Y'
       Store 'TLABELX.DBF' to MFILEX
       If file(MFILEX)
         use &MFILEX
         Copy to &MFILE
         USE &MFILE
         Index on datesort to &MFILE
         Accept 'New TLABELS file is now created. Press <RETN> ' to XX
       else
     Accept 'File TLABELX not found on the program disk. Press <RETURN>' to XX
       endif
     endif
     Store d+':TLABELS' to MFILE
     USE &MFILE index &MFILE
    Case !(ESEL)='6'
      Use UDIRFILE
      ?
      ? '  Editing CTAPELIB Names Directory parameters'
Use udirfile
GOTO 2
Store $(SPACT,21,1) to MD2
GOTO 5
Store $(spact,28,2) to MD4
SKIP
STORE $(SPACT,28,2) TO MD5
SKIP
Store $(spact,28,2) to MD6
  @ 18,0 say 'Disk I.D. containing data files ' get MD2
  @ 19,0 SAY 'Tape Labels, LINES PER PAGE ' GET MD4
  @ 20,0 SAY 'Tape Labels, labels  spacing' GET MD5
  @ 21,0 SAY 'Tape Labels, 1st column     ' GET MD6
  READ
  ?
  Accept '    SAVE? ' to MDX
  If !(MDX)='Y'
    GOTO 2
    Replace spact with $(SPACT,1,20)+MD2
    Store !(MD2) to D
    GOTO 5
    Replace spact with $(spact,1,27)+MD4
    Store val(MD4) to labellp
    SKIP
    Replace spact with $(spact,1,27)+MD5
    Store val(MD5) to labelspa
    SKIP
    Replace spact with $(spact,1,27)+MD6
    Store val(MD6) to labl1col
    SKIP
  endif
    Case !(ESEL) = 'Q'
      Store F to continue
    endcase
  enddo
USE
Store T to validd1
RETURN
= 'Q'
      Store F to continue
    endcase
  enddo
USE
Store T to validd1
RETURN
,17 get title2
  @ 7,8  say 'TEXT     ' get text
  @ 8,8 say  'SPEAKER  ' get speaker
  @ 9,8 say  'DATE     ' get date
  @ 9,40 say 'SERIES '   get series
  @ 11,20 say 'Press ctrl-W when finished'
  READ
  Stor